home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1994 December
/
PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin
/
prgmming
/
win
/
pascal
/
mfloat.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-21
|
6KB
|
161 lines
PROGRAM MemFloat;
Uses WinTypes, WinProcs, WObjects;
{$D MemFloat, Copyright (c) 1991 by Chris P. Thornton, based on: }
{$D Floater, Copyright (c) 1991 by Neil J. Rubenking}
{$D Contributions from: Kurt B. Barthelmess }
{$D Contributions from: Craig Boyd }
{$D Contributions from: Tony Vitabile }
{At long last, this is the result of the "Window On Top" thread that ran in
mid December 1991. I needed an example of a window that would keep itself
on top of other windows. Craig Boyd pulled up an example that Neil Rubenking
has posted back in September (I guess I still had my nose buried in the
"Cookbook" back then.)
It worked by checking to see whether or not its window had the input focus.
If not, then it moved itself to the top, without stealing the input focus.
This solution did what it was supposed to do, but could sometimes cause a
"twinkling" effect as it repainted itself repeatedly. It couldn't tell that
it was already on top of all of the other windows.
Tony Vitabile had sent me a note to check into the SetWindowPos() function,
as an alternative.
I was able to get both of these solutions to work, but I still needed to find
a way to determine whether the windows really needed painting or not. Finally,
Kurt B. Barthelmess came to my rescue with the following:
if GetWindow(HWindow, gw_HWndPrev) <> 0 then
SetWindowPos(HWindow, 0, 0, 0, 0, 0,
swp_NoMove or swp_NoSize or swp_NoActivate);
This checks the position (in the Z-Order), and then re-positions only if
necessary.
As Kurt pointed out, you need to make sure that you are not in contention with
another app. If multiple apps are trying to stay on top, they will hog the
system, and twinkle like crazy!
Also, I have found that any app employing this technique will defeat any
screen saver that I've come accross. If anyone can find a way to detect that,
please add to this program!
Lastly, I decided that in order to justify my re-posting of this compilation
of other people's work, I needed to add something of value.
As I was struggling with heap storage at the time that I was going through this
excercise, I made a little memory detective out of it. It will display
MaxAvail - largest contiguous heap block available, as well as
MemAvail - Total heap available.
I keep the previous values around for the next timer tick, so that I don't
re-display, unless it's necessary.
I added a wm_Size method, to display the values in dynamically-sized edit windows.
Again, I would like to thank everyone that participated in the "Windows On Top"
thread. There's NO WAY that I could have figured this out on my own.
Chris Thornton
}
CONST
AppName : PChar = 'MemFloat';
MyTimer = 1;
TYPE
TMyApplication = object(TApplication)
PROCEDURE InitMainWindow; virtual;
END;
PTestWindow = ^TTestWindow;
TTestWindow = OBJECT(TWindow)
oldmaxavail : LongInt; {previous value}
oldMemavail : LongInt;
MaxEdit : PEdit; {edit box to display in}
MemEdit : PEdit;
CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
DESTRUCTOR Done; Virtual;
PROCEDURE SetUpWindow; Virtual;
PROCEDURE wmsize(var Message: TMessage); virtual wm_first + wm_Size;
FUNCTION GetClassName : PChar; Virtual;
PROCEDURE wmTimer(VAR Msg : TMessage); Virtual
wm_First + wm_Timer;
END;
PROCEDURE TTestWindow.wmTimer;
var dtext : array[0..10] of Char;
BEGIN
if GetWindow(HWindow, gw_HWndPrev) <> 0 then
SetWindowPos(HWindow, 0, 0, 0, 0, 0,
swp_NoMove or swp_NoSize or swp_NoActivate);
{This looks to see if your window is at the top of the Z-order.
If not, then it puts you there, without moving, sizing, or
activating yourself.}
{ Now, to make this app useful, report MaxAvail and MemAvail }
if (MaxAvail <> OldMaxAvail) or (MemAvail <> OldMemAvail) then
begin {re-display figures only when they have actually changed}
OldMaxAvail := MaxAvail; {save for next time around...}
OldMemAvail := MemAvail;
Str(OldMaxAvail,dtext);
MaxEdit^.SetText(dtext); {display}
Str(MemAvail,Dtext);
MemEdit^.SetText(dtext);
end;
END;
CONSTRUCTOR TTestWindow.Init;
BEGIN
TWindow.Init(AParent, 'MaxAvail | MemAvail');
Attr.Menu := LoadMenu(hInstance, AppName);
Attr.Style := Attr.Style AND (NOT ws_MaximizeBox)
AND (NOT ws_MinimizeBox);
Attr.W := 200;
Attr.H := GetSystemMetrics(sm_CYCaption) + 30;
MaxEdit := new(PEdit, Init (@Self, 100, '',0,0,0,0,0,False));
MemEdit := new(PEdit, Init (@Self, 100, '',0,0,0,0,0,False));
END;
PROCEDURE TTestWindow.SetUpWindow;
BEGIN
TWIndow.SetUpWindow;
SetTimer(hWindow, MyTimer, 1000, NIL);
END;
{WMSIZE method - dynamically size edit windows to fit within new window}
{MaxEdit is edit box to display MaxAvail. }
{MemEdit is edit box to display MemAvail. }
{Width of window is Message.LParamLo }
{Height of window is Message.LParamHi }
PROCEDURE TTestWindow.wmsize(var Message: TMessage);
BEGIN
TWindow.WMSize(Message);
SetWindowPos(MaxEdit^.HWindow, 0, 0, 0,
(Message.LParamLo div 2), Message.LParamHi, swp_NoZOrder);
SetWindowPos(MemEdit^.HWindow, 0, (Message.LParamLo div 2), 0,
Message.LParamLo,Message.LParamHi, swp_NoZOrder);
END;
DESTRUCTOR TTestWindow.Done;
BEGIN
KillTimer(hWindow, MyTimer);
TWindow.Done;
END;
FUNCTION TTestWindow.GetClassName;
BEGIN
GetClassName := AppName;
END;
PROCEDURE TMyApplication.InitMainWindow;
BEGIN
MainWindow := New(PTestWindow, Init(Nil, AppName));
END;
VAR
MyApp : TMyApplication;
BEGIN
MyApp.Init(AppName);
MyApp.Run;
MyApp.Done;
END.